      SUBROUTINE SETUP
      RETURN
      END
C   HS118
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER I,J
      DATA (X(I),I=1,15)
     F     /20.D0,55.D0,15.D0,20.D0,60.D0,2*20.D0,60.D0,2*20.D0,60.D0,
     1        2*20.D0,60.D0,20.D0/
      DATA NAME/'HS118M2'/
      DATA N/15/ , NH/1/ , NG/59/
      DATA DEL0/1.00D0/ ,TAU0/1.D0/ ,TAU/.1D0/
      DATA (GUNIT(1,I),I=0,30)/31*-1/,((GUNIT(I,J),I=2,3),J=0,30)/62*0/,
     F     (GUNIT(3,I),I=31,60)/15*1,15*-1/,(GUNIT(2,I),I=31,60)/
     F     1,2,3,4,
     F     5,6,7,8,9,10,11,12,13,14,15,1,2,3,4,5,6,7,8,9,10,11,12,13,14,
     F     15/,
     F     (GUNIT(1,I),I=31,60)/30*1/
      END
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),B(15),C(15),FX,S
      DATA B/2.3D0,1.7D0,2.2D0,2.3D0,1.7D0,2.2D0,2.3D0,1.7D0,2.2D0,
     1       2.3D0,1.7D0,2.2D0,2.3D0,1.7D0,2.2D0/
      DATA C/2*1.D-4,1.5D-4,2*1.D-4,1.5D-4,2*1.D-4,1.5D-4,
     1       2*1.D-4,1.5D-4,2*1.D-4,1.5D-4/
      ICF=ICF+1
      S=0.D0
      DO      100      I=1,15
      S=S+(C(I)*X(I)+B(I))*X(I)
  100 CONTINUE
      FX=S
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADF(NX),B(15),C(15)
      DATA B/2.3D0,1.7D0,2.2D0,2.3D0,1.7D0,2.2D0,2.3D0,1.7D0,2.2D0,
     1       2.3D0,1.7D0,2.2D0,2.3D0,1.7D0,2.2D0/
      DATA C/2*1.D-4,1.5D-4,2*1.D-4,1.5D-4,2*1.D-4,1.5D-4,
     1       2*1.D-4,1.5D-4,2*1.D-4,1.5D-4/
      ICGF=ICGF+1
      DO      100      I=1,15
      GRADF(I)=2.D0* C(I)*X(I)+B(I)
  100 CONTINUE
      RETURN
      END
      SUBROUTINE EH(I,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),HXI
      CRES(I)=CRES(I)+1
      HXI=X(1)+X(3)-X(6)-11.D0
      RETURN
      END
      SUBROUTINE EGRADH(I,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX),GRADHI(NX)
      CGRES(I)=CGRES(I)+1
      DO J=1,NX
          GRADHI(J)=0.D0
      ENDDO
      GRADHI(1)=1.D0
      GRADHI(3)=1.D0
      GRADHI(6)=-1.D0
      RETURN
      END
      SUBROUTINE EG(I,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION GXI,S
      DOUBLE PRECISION 
     F    X(NX),US(15),OS(15),B(15,24),C(15,5),OS1(12),US1(5)
      SAVE US,OS,OS1,C,B,US1
      DATA US/-8.D0,43.D0,3.D0,2*0.D0,0.D0,9*0.D0/
      DATA OS/21.D0,57.D0,16.D0,90.D0,120.D0,60.D0,90.D0,120.D0,60.D0,
     1        90.D0,120.D0,60.D0,90.D0,120.D0,60.D0/
      DATA C/3*1.D0,15*0.D0,3*1.D0,15*0.D0,
     1       3*1.D0,15*0.D0,3*1.D0,15*0.D0,3*1.D0/
      DATA OS1/13.D0,14.D0,2*13.D0,14.D0,2*13.D0,14.D0,2*13.D0,14.D0,
     1         13.D0/, US1/60.D0,50.D0,70.D0,85D0,100.D0/
      DATA B/-1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     1       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     2       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     3       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     4       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     5       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,
     *       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     1       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     2       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     3       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     4       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     5       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0/
      IF ( I .LE. 29 ) CRES(I+NH)=CRES(I+NH)+1
      IF(I .GT. 44)      GOTO 700
      IF(I .GT. 29)      GOTO 600
      IF(I .GT. 24)      GOTO 400
      IF(I .GT. 12)      GOTO 200
      S=7.D0
      DO      100      J=1,15
      S=S+B(J,I)*X(J)
  100 CONTINUE
      GXI= S
      RETURN
  200 CONTINUE
      S=7.D0
      DO      300      J=1,15
      S=S+B(J,I)*X(J)
  300 CONTINUE
      GXI=OS1(I-12)-S
      RETURN
  400 CONTINUE
      S=-US1(I-24)
      DO      500      J=1,15
      S=S+C(J,I-24)*X(J)
  500 CONTINUE
      GXI=S
      RETURN
  600 CONTINUE
      GXI=X(I-29)-US(I-29)
      RETURN
  700 CONTINUE
      GXI=OS(I-44)-X(I-44)
      RETURN
      END
      SUBROUTINE EGRADG(I,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX) ,GRADGI(NX),B(15,24),C(15,5)
      SAVE B,C
      DATA C/3*1.D0,15*0.D0,3*1.D0,15*0.D0,
     1       3*1.D0,15*0.D0,3*1.D0,15*0.D0,3*1.D0/
      DATA B/-1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     1       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     2       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     3       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     4       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     5       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,
     *       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     1       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     2       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     3       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     4       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0,12*0.D0,
     5       -1.D0,2*0.D0,1.D0,12*0.D0,-1.D0,2*0.D0,1.D0/
      IF ( I .GT. 29 ) RETURN
      CGRES(I+NH)=CGRES(I+NH)+1
      IF(I .GT. 44)      GOTO 800
      IF(I .GT. 29)      GOTO 600
      IF(I .GT. 24)      GOTO 400
      IF(I .GT. 12)      GOTO 200
      DO      100      J=1,15
      GRADGI(J)=B(J,I)
  100 CONTINUE
      RETURN
  200 CONTINUE
      DO      300      J=1,15
      GRADGI(J)=-B(J,I)
  300 CONTINUE
      RETURN
  400 CONTINUE
      DO      500      J=1,15
      GRADGI(J)=C(J,I-24)
  500 CONTINUE
      RETURN
  600 CONTINUE
      DO      700      J=1,15
      GRADGI(J)=0.D0
  700 CONTINUE
      GRADGI(I-29)=1.D0
      RETURN
  800 CONTINUE
      DO      900      J=1,15
      GRADGI(J)=0.D0
  900 CONTINUE
      GRADGI(I-44)=-1.D0
      RETURN
      END


